COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "CARF1"
C00007 ENDMK
C⊗;
BEGIN "CARF1"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "CARR.SAI[AER,HPM]" SOURCE_FILE;

INTEGER I,J,K,L,M,N,PSIZ,DCHAN,PSIZ2;
STRING FN;
BOOLEAN SYNA;

DO OUTSTR("PICTURE:") UNTIL (PSIZ←PFLDIM(FN←INCHWL))≠0;
   BEGIN
   INTEGER ARRAY PA[0:PSIZ];
   GETPFL(FN,PA[0]);
   PSIZ2←PIXDIM(PA[PCLN]%2,PA[LNBY]%2,PA[BYBI]);
   END;

DDINIT;
SCREEN(-.5,1.5,1.5,-.5);
DRKEN; RECTAN(-1000,-1000,1000,1000);
FOR I←0 STEP 1 UNTIL 7 DO FOR J←0,0,0,0 DO DPYUP(SYNMAP(I));
SHOWA('47);

   BEGIN
   INTEGER ARRAY PA[0:PSIZ2];
   INTEGER BITS;

      BEGIN
      INTEGER ARRAY PB[0:PSIZ];
      GETPFL(FN,PB[0]);
      MAKPIX(PB[PCLN]%2,PB[LNBY]%2,PB[BYBI],PA[0]);
      SELECT(PB[0],PB[PCLN]%2,PB[LNBY]%2,PA[0]);
      END;

   GRAY(PA[0]);  MAPGRY(0.5,PA[BYBI]+1);
   BITS←PA[BYBI];
   FOR I←1 STEP 1 UNTIL BITS DO
   IF SYNMAP(I)>0 THEN
      BEGIN
      INTEGER XP,YP,DBIT;
      DBIT←BITS-I;
      DRKEN; RECTAN(0,0,1,1);
      VIDEO(0,0,1,1,PA[0],1 ASH DBIT);
      FOR J←1,2,3 DO DPYUP(SYNMAP(I));
      END;
   UNGRAY(PA[0]);

      BEGIN
      REAL ARRAY QC,QD[0:PA[PCLN]-CARH12,0:PA[LNBY]-CARW12];
      INTEGER XL,XH,YL,YH; REAL AVRG,LOA,HIA;

      XL←0; YL←0; XH←PA[LNBY]-1; YH←PA[PCLN]-1;
      outstr("into vcar"&'15&'12);
      AVRG←VCAR(PA[0],XL,YL,XH,YH,QC[0,0]);
      outstr("out of vcar"&'15&'12);
      PUTPFL(PA[0],"A");
      LOA←9999;  HIA←-9999;
      FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
      FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
         BEGIN
         HIA←HIA MAX ABS(QC[I,J]);
         LOA←LOA MIN ABS(QC[I,J]);
         END;
      MAKPIX(PA[PCLN],PA[LNBY],PA[BYBI],PA[0]);
      WIPE(PA[0]);
      FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
      FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
         PUTEL(PA[0],I+CARH12%2,J+CARW12%2,
               (2↑PA[BYBI]-1)*(ABS(QC[I,J])-HIA)/(LOA-HIA));
      PUTPFL(PA[0],"B");
      DRKEN; RECTAN(-1000,-1000,1000,1000);
      VIDEO(0,0,1,1,PA[0],1 ASH (PA[BYBI]-1));
      FOR J←1,1,1 DO DPYUP(SYNMAP(0));
      SHOW('47);
    
      FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
      FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
         BEGIN
         INTEGER II,JJ,IMIN,JMIN,IMAX,JMAX;
         IMIN←(I-CARH12%2) MAX 0; IMAX←(I+CARH12%2) MIN (PA[PCLN]-CARH12);
         JMIN←(J-CARW12%2) MAX 0; JMAX←(J+CARW12%2) MIN (PA[LNBY]-CARW12);
         LOA←9999;
         FOR II←IMIN STEP 1 UNTIL IMAX DO FOR JJ←JMIN STEP 1 UNTIL JMAX DO
         LOA←LOA MIN QC[II,JJ];
         QD[I,J]←(IF QC[I,J]=LOA THEN LOA ELSE HIA);
         END;

      WIPE(PA[0]);
      FOR I←0 STEP 1 UNTIL PA[PCLN]-CARH12 DO
      FOR J←0 STEP 1 UNTIL PA[LNBY]-CARW12 DO
         PUTEL(PA[0],I+CARH12%2,J+CARW12%2,
               (2↑PA[BYBI]-1)*(QD[I,J]-HIA)/(LOA-HIA));
      PUTPFL(PA[0],"C");
      DRKEN; RECTAN(-1000,-1000,1000,1000);
      VIDEO(0,0,1,1,PA[0],1 ASH (PA[BYBI]-1));
      FOR J←1,1,1 DO DPYUP(SYNMAP(0));
      SHOW('47);

      END;
   END;
END;